home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / c / genmo112.lha / GTB-Modula / GenModula / GeneratorIO.mod < prev    next >
Encoding:
Modula Implementation  |  1993-09-28  |  6.2 KB  |  263 lines
  1. IMPLEMENTATION MODULE GeneratorIO;
  2.  
  3. (*
  4.  * -------------------------------------------------------------------------
  5.  *
  6.  *    :Program.    GenModula
  7.  *    :Contents.    A Modula 2 Sourcecode generator for GadToolsBox
  8.  *
  9.  *    :Author.    Reiner B. Nix
  10.  *    :Address.    Geranienhof 2, 50769 Köln Seeberg
  11.  *    :Address.    rbnix@pool.informatik.rwth-aachen.de
  12.  *    :Copyright.    Reiner B. Nix
  13.  *    :Language.    Modula-2
  14.  *    :Translator.    M2Amiga A-L V4.2d
  15.  *    :Imports.    GadToolsBox, NoFrag  by Jaan van den Baard
  16.  *    :Imports.    InOut, NewArgSupport by Reiner Nix
  17.  *    :History.    this programm is a direct descendend from
  18.  *    :History.     OG (Oberon Generator) 37.11 by Thomas Igracki, Kai Bolay
  19.  *    :History.    GenModula 1.10 (23.Aug.93)    ;M2Amiga 4.0d
  20.  *    :History.    GenModula 1.12 (28.Sep.93)    ;M2Amiga 4.2d
  21.  *
  22.  * -------------------------------------------------------------------------
  23.  *)
  24.  
  25. FROM    SYSTEM            IMPORT    ADR,
  26.                     TAG;
  27. FROM    Arts            IMPORT    Assert;
  28. FROM    String            IMPORT    Length, FirstPos,
  29.                     Copy, CopyPart, Concat;
  30. FROM    Conversions        IMPORT    ValToStr;
  31. FROM    FileSystem        IMPORT    File, Response,
  32.                     Lookup, Close,
  33.                     GetPos, SetPos;
  34. FROM    FileMessage        IMPORT    StrPtr,
  35.                     ResponseText;
  36. FROM    FileOut            IMPORT    Write, WriteString, WriteLn,
  37.                     WriteCard, WriteInt, WriteHex;
  38. FROM    DosL            IMPORT    FilePart;
  39. FROM    UtilityD        IMPORT    tagEnd,
  40.                     TagItem;
  41. FROM    NewArgSupport        IMPORT    UseArguments,
  42.                     ArgBoolean, ArgString;
  43. FROM    NoFrag            IMPORT    MemoryChainPtr,
  44.                     GetMemoryChain, FreeMemoryChain;
  45. FROM    GadToolsBox        IMPORT    gtbErrors, rgTags,
  46.                     vlfFlagSet,
  47.                     GenC,
  48.                     LoadGuiA, FreeWindows;
  49. IMPORT    InOut;
  50.  
  51.  
  52. CONST    Version            ="$VER: GenModula 1.12 (28.Sep.93) by Reiner B. Nix";
  53.  
  54.  
  55. VAR    Chain            :MemoryChainPtr;
  56.     ValidBits        :vlfFlagSet;
  57.     ProjectsLoad        :BOOLEAN;
  58.  
  59.  
  60. (*
  61.  * --- Hilfprozeduren -----------------------------------------------------------
  62.  *)
  63. PROCEDURE WriteFill        (VAR file        :File;
  64.                      text        :ARRAY OF CHAR;
  65.                      offset        :LONGINT);
  66.  
  67. CONST    maxTab    =8;
  68.     maxFill    =3 * maxTab;
  69.  
  70.  
  71. VAR    i, n            :INTEGER;
  72.     empty            :ARRAY [0..20] OF CHAR;
  73.  
  74. BEGIN
  75. n := offset + Length (text);
  76. i := 0;
  77. WHILE n < maxFill DO
  78.   empty[i] := "\t";
  79.   INC (i);
  80.   INC (n, maxTab)
  81.   END;
  82. empty[i] := 0C;
  83. WriteString (file, empty)
  84. END WriteFill;
  85.  
  86.  
  87. PROCEDURE SeekBack        (VAR file        :File;
  88.                      bytes        :LONGINT);
  89.  
  90. VAR    actual            :LONGINT;
  91.  
  92. BEGIN
  93. GetPos (file, actual);
  94. SetPos (file, actual - bytes)
  95. END SeekBack;
  96.  
  97.  
  98.  
  99. PROCEDURE GetAttrName        (VAR attrName        :ARRAY OF CHAR);
  100.  
  101. VAR    error            :BOOLEAN;
  102.     i            :INTEGER;
  103.     attrSize        :ARRAY [0..5] OF CHAR;
  104.  
  105. BEGIN
  106. Copy (attrName, Gui.fontName);
  107. i := FirstPos (attrName, 0, ".");
  108. IF i # -1 THEN
  109.   attrName[i] := 0C
  110.   END;
  111. ValToStr (Gui.font.ySize, FALSE, attrSize, 10, 1, " ", error);
  112. Concat (attrName, attrSize)
  113. END GetAttrName;
  114.  
  115.  
  116.  
  117. PROCEDURE WriteText        (VAR file        :File;
  118.                      text        :ARRAY OF CHAR);
  119.  
  120. BEGIN
  121. WriteString (file, text);
  122. IF text[1] = 0C THEN
  123.   WriteString (file, "\\o")
  124.   END
  125. END WriteText;
  126.  
  127.  
  128.  
  129. (*
  130.  * --- Gui Access ---------------------------------------------------------------
  131.  *)
  132. PROCEDURE OpenGui;
  133.  
  134. VAR    guiTags        :ARRAY [0..4] OF TagItem;
  135.     error        :gtbErrors;
  136.     errorText    :ARRAY [0..80] OF CHAR;
  137.     shortVersion    :ARRAY [0..80] OF CHAR;
  138.     Config        :GenC;
  139.  
  140. BEGIN
  141. error := LoadGuiA (Chain,
  142.                    ADR (args.name),
  143.                    TAG (guiTags,
  144.                         rgGUI,        ADR (Gui),
  145.                         rgCConfig,    ADR (Config),
  146.                         rgWindowList,    ADR (Projects),
  147.                         rgValid,    ADR (ValidBits),
  148.                         tagEnd));
  149.  
  150. IF error = gtbErrorOpen THEN
  151.   Concat (args.name, ".gui");
  152.   error := LoadGuiA (Chain,
  153.                      ADR (args.name),
  154.                      TAG (guiTags,
  155.                           rgGUI,        ADR (Gui),
  156.                           rgCConfig,    ADR (Config),
  157.                           rgWindowList,    ADR (Projects),
  158.                           rgValid,    ADR (ValidBits),
  159.                           tagEnd))
  160.   END;
  161.  
  162. ProjectsLoad := TRUE;
  163. CASE error OF
  164. | gtbErrorNone       : errorText := "Alles klar?";
  165. | gtbErrorNoMem      : errorText := "LoadGui: Speichermangel!";
  166. | gtbErrorOpen       : errorText := "LoadGui: GUI-Datei nicht zu öffnen!";
  167. | gtbErrorRead       : errorText := "LoadGui: Lesefehler!";
  168. | gtbErrorWrite      : errorText := "LoadGui: Schreibfehler!";
  169. | gtbErrorParse      : errorText := "LoadGui: iffparse-Fehler";
  170. | gtbErrorPacker     : errorText := "LoadGui: GUI-Datei nicht zu entpacken!";
  171. | gtbErrorPPLib      : errorText := "LoadGui: powerpacker.library wird benötigt!";
  172. | gtbErrorNotGuiFile : errorText := "LoadGui: keine GUI-Datei!"
  173.   END;
  174.  
  175. Assert (error = gtbErrorNone, ADR (errorText));
  176.  
  177. MainConfig := Config.gtConfig;
  178. CConfig    := Config.genCFlags0;
  179.  
  180. CopyPart (shortVersion, Version, 6, Length (Version)-6);
  181.  
  182. InOut.WriteLn;
  183. InOut.WriteString (shortVersion); InOut.WriteLn;
  184. InOut.WriteLn;
  185. InOut.WriteString (" - "); InOut.WriteString (args.name); InOut.WriteLn;
  186. END OpenGui;
  187.  
  188.  
  189. PROCEDURE OpenFiles;
  190.  
  191. VAR    ModName, DefName        :ARRAY [0..50] OF CHAR;
  192.     errorText            :StrPtr;
  193.  
  194. BEGIN
  195. Copy (args.BaseName, StrPtr (FilePart (ADR (args.fileName)))^);
  196.  
  197. Copy (ModName, args.fileName);
  198. Copy (DefName, args.fileName);
  199. Concat (ModName, ".mod");
  200.  
  201. IF ArgBoolean ("NODEF", FALSE) THEN
  202.   Concat (DefName, ".nodef")
  203. ELSE
  204.   Concat (DefName, ".def")
  205.   END;
  206.  
  207. Lookup (dfile, DefName, 5*1024, TRUE);
  208. Lookup (mfile, ModName, 5*1024, TRUE);
  209.  
  210. ResponseText (mfile.res, errorText);
  211. Assert (mfile.res = done, errorText);
  212.  
  213. ResponseText (dfile.res, errorText);
  214. Assert (dfile.res = done, errorText);
  215.  
  216.  
  217. InOut.WriteString (" + "); InOut.WriteString (DefName); InOut.WriteLn;
  218. InOut.WriteString (" + "); InOut.WriteString (ModName); InOut.WriteLn
  219. END OpenFiles;
  220.  
  221.  
  222. PROCEDURE CloseFiles;
  223.  
  224. BEGIN
  225. Close (mfile);
  226. Close (dfile);
  227. END CloseFiles;
  228.  
  229.  
  230. (* GeneratorIO *)
  231. BEGIN
  232. Chain := NIL;
  233. ProjectsLoad := FALSE;
  234.  
  235. UseArguments ("NAME/A,TO=AS/A,RASTER/S,UNDERMOUSE/S,NODEF/S");
  236. WITH args DO
  237.   ArgString ("NAME", "::", name);
  238.   ArgString ("TO",   "::", fileName);
  239.   raster := ArgBoolean ("RASTER", FALSE);
  240.   mouse  := ArgBoolean ("UNDERMOUSE", FALSE)
  241.   END;
  242.  
  243. Chain := GetMemoryChain (4096);
  244. Assert (Chain # NIL, ADR ("NoFrag.library: keine Liste erhältlich."));
  245.  
  246. OpenGui;
  247. OpenFiles;
  248.  
  249.  
  250. CLOSE
  251. CloseFiles;
  252.  
  253. IF ProjectsLoad THEN
  254.   FreeWindows (Chain, ADR (Projects));
  255.   ProjectsLoad := FALSE;
  256.   END;
  257.  
  258. IF Chain # NIL THEN
  259.   FreeMemoryChain (Chain, TRUE);
  260.   Chain := NIL
  261.   END
  262. END GeneratorIO.
  263.